excel VBA 提示-Excel VBA实现渐进式模糊搜索

Excel在录入时可以匹配现有的内容，但有时还是满足不了我们的要求，以下是用Excel VBA实现的渐进式模糊搜索

作者：Excel小子-Office中国

实现的效果：

Excel 模糊 渐进式搜索操作动画教程

Excel VBA实现渐进式模糊搜索的主要代码：

先放置 一个 TextBox1 文本框 及列表框 ListBox1

然后在工作表代码中

Dim d

Dim arr, brr(0)

Dim ar

Private Sub ListBox1_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

ActiveCell = Me.ListBox1.Value

Me.ListBox1.Visible = False

Me.TextBox1.Visible = False

ActiveCell.Select

End Sub

Private Sub ListBox1_GotFocus()

End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then

ActiveCell = ListBox1.Value

Me.ListBox1.Visible = False

Me.TextBox1.Visible = False

ActiveCell.Select

End If

End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If WorksheetFunction.CountA(ActiveSheet.UsedRange) > 0 Then

    If WorksheetFunction.CountA(ActiveSheet.UsedRange) = 1 Then

        brr(0) = ActiveSheet.UsedRange

        arr = brr

    Else

        arr = ActiveSheet.UsedRange

    End If

    Dim ct

   Set d = CreateObject("scripting.dictionary")

    If KeyCode = vbKeyDown Then

    'Stop

            ct = ListBox1.ListIndex + 1

        If ct < ListBox1.ListCount Then ListBox1.ListIndex = ct Else ListBox1.ListIndex = 0

    ElseIf KeyCode = vbKeyUp Then

        ct = ListBox1.ListIndex - 1

        If ct > -1 Then ListBox1.ListIndex = ct Else ListBox1.ListIndex = ListBox1.ListCount - 1

        End If

    If KeyCode <> 37 And KeyCode <> 39 And KeyCode <> 13 Then

        For Each ar In arr

            If Len(ar) > 0 Then

            If InStr(ar, TextBox1.Value) = 1 Then

                d(ar) = ""

            End If

            End If

        Next ar

    End If

    If d.Count > 0 And Len(Me.TextBox1.Value) > 0 Then

        With Me.ListBox1

        .Visible = True

        .Left = ActiveCell.Left + ActiveCell.Width

        .Top = ActiveCell.Top

        .Height = ActiveCell.Height * 5

        .Width = ActiveCell.Width * 2

        .List = d.keys

        End With

    Else

        Me.ListBox1.Visible = False

    End If

    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

If Target.Count = 1 Then

    Me.ListBox1.Visible = False

    With Me.TextBox1

        .Value = ""

        .Visible = True

        .Activate

        .Left = Target.Left

        .Top = Target.Top

        .Width = Target.Width

        .Height = Target.Height

    End With

End If

End Sub